library(tidyverse)
data("diamonds")
alter <- 42 # a
name <- "Schorsch" # b
schorsch <- "42" # c
name <- schorsch
Laden Sie zunächst die Tabelle “diamonds”.
Filtern Sie …
data("diamonds") # ggplot2, das ist Teil des Tidyverse
diamonds %>%
filter(cut == "Ideal")
## # A tibble: 21,551 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 0.23 Ideal E SI2 61.5 55 326 3.95 3.98 2.43
## 2 0.23 Ideal J VS1 62.8 56 340 3.93 3.9 2.46
## 3 0.31 Ideal J SI2 62.2 54 344 4.35 4.37 2.71
## 4 0.3 Ideal I SI2 62 54 348 4.31 4.34 2.68
## 5 0.33 Ideal I SI2 61.8 55 403 4.49 4.51 2.78
## 6 0.33 Ideal I SI2 61.2 56 403 4.49 4.5 2.75
## 7 0.33 Ideal J SI1 61.1 56 403 4.49 4.55 2.76
## 8 0.23 Ideal G VS1 61.9 54 404 3.93 3.95 2.44
## 9 0.32 Ideal I SI1 60.9 55 404 4.45 4.48 2.72
## 10 0.3 Ideal I SI2 61 59 405 4.3 4.33 2.63
## # … with 21,541 more rows
alle Diamanten mit einem Preis zwischen 1000 und 10000 Dollar.
diamonds %>%
filter(price >= 1e3 & price <= 1e4)
## # A tibble: 34,219 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 0.7 Ideal E SI1 62.5 57 2757 5.7 5.72 3.57
## 2 0.86 Fair E SI2 55.1 69 2757 6.45 6.33 3.52
## 3 0.7 Ideal G VS2 61.6 56 2757 5.7 5.67 3.5
## 4 0.71 Very Good E VS2 62.4 57 2759 5.68 5.73 3.56
## 5 0.78 Very Good G SI2 63.8 56 2759 5.81 5.85 3.72
## 6 0.7 Good E VS2 57.5 58 2759 5.85 5.9 3.38
## 7 0.7 Good F VS1 59.4 62 2759 5.71 5.76 3.4
## 8 0.96 Fair F SI2 66.3 62 2759 6.27 5.95 4.07
## 9 0.73 Very Good E SI1 61.6 59 2760 5.77 5.78 3.56
## 10 0.8 Premium H SI1 61.5 58 2760 5.97 5.93 3.66
## # … with 34,209 more rows
diamonds %>%
filter(between(price, 1e03, 1e04))
## # A tibble: 34,219 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 0.7 Ideal E SI1 62.5 57 2757 5.7 5.72 3.57
## 2 0.86 Fair E SI2 55.1 69 2757 6.45 6.33 3.52
## 3 0.7 Ideal G VS2 61.6 56 2757 5.7 5.67 3.5
## 4 0.71 Very Good E VS2 62.4 57 2759 5.68 5.73 3.56
## 5 0.78 Very Good G SI2 63.8 56 2759 5.81 5.85 3.72
## 6 0.7 Good E VS2 57.5 58 2759 5.85 5.9 3.38
## 7 0.7 Good F VS1 59.4 62 2759 5.71 5.76 3.4
## 8 0.96 Fair F SI2 66.3 62 2759 6.27 5.95 4.07
## 9 0.73 Very Good E SI1 61.6 59 2760 5.77 5.78 3.56
## 10 0.8 Premium H SI1 61.5 58 2760 5.97 5.93 3.66
## # … with 34,209 more rows
diamonds %>%
filter(cut == "Ideal", color == "D")
## # A tibble: 2,834 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 0.3 Ideal D SI1 62.5 57 552 4.29 4.32 2.69
## 2 0.3 Ideal D SI1 62.1 56 552 4.3 4.33 2.68
## 3 0.71 Ideal D SI2 62.3 56 2762 5.73 5.69 3.56
## 4 0.71 Ideal D SI1 61.9 59 2764 5.69 5.72 3.53
## 5 0.71 Ideal D SI2 61.6 55 2767 5.74 5.76 3.54
## 6 0.76 Ideal D SI2 62.4 57 2770 5.78 5.83 3.62
## 7 0.73 Ideal D SI2 59.9 57 2770 5.92 5.89 3.54
## 8 0.75 Ideal D SI2 61.3 56 2773 5.85 5.89 3.6
## 9 0.72 Ideal D SI1 60.8 57 2782 5.76 5.75 3.5
## 10 0.64 Ideal D VS1 61.5 56 2787 5.54 5.55 3.41
## # … with 2,824 more rows
diamonds %>%
slice_max(order_by = price, prop = .1)
## # A tibble: 5,396 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 2.29 Premium I VS2 60.8 60 18823 8.5 8.47 5.16
## 2 2 Very Good G SI1 63.5 56 18818 7.9 7.97 5.04
## 3 1.51 Ideal G IF 61.7 55 18806 7.37 7.41 4.56
## 4 2.07 Ideal G SI2 62.5 55 18804 8.2 8.13 5.11
## 5 2 Very Good H SI1 62.8 57 18803 7.95 8 5.01
## 6 2.29 Premium I SI1 61.8 59 18797 8.52 8.45 5.24
## 7 2.04 Premium H SI1 58.1 60 18795 8.37 8.28 4.84
## 8 2 Premium I VS1 60.8 59 18795 8.13 8.02 4.91
## 9 1.71 Premium F VS2 62.3 59 18791 7.57 7.53 4.7
## 10 2.15 Ideal G SI2 62.6 54 18791 8.29 8.35 5.21
## # … with 5,386 more rows
d2 <- diamonds %>%
mutate(price_percent = percent_rank(price)) %>%
filter(price_percent > .9)
d2
## # A tibble: 5,393 x 11
## carat cut color clarity depth table price x y z price_percent
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 1.53 Very G… I VS1 59.3 58 9823 7.5 7.54 4.46 0.900
## 2 3.11 Fair J I1 65.9 57 9823 9.15 9.02 5.98 0.900
## 3 1.5 Ideal I VS2 60 61 9827 7.39 7.42 4.44 0.900
## 4 1.5 Very G… I VVS2 63.3 58 9828 7.24 7.21 4.57 0.900
## 5 1.5 Good I VS1 57.9 60 9828 7.48 7.44 4.32 0.900
## 6 1.5 Ideal E SI1 61.9 57 9828 7.37 7.31 4.54 0.900
## 7 1.5 Premium I VS1 61.6 59 9828 7.32 7.26 4.49 0.900
## 8 1.52 Premium E SI2 58.1 60 9831 7.59 7.53 4.39 0.900
## 9 1.08 Ideal G IF 62.3 56 9831 6.55 6.59 4.09 0.900
## 10 1.51 Ideal H SI1 61.3 56 9833 7.4 7.44 4.55 0.900
## # … with 5,383 more rows
cut?diamonds %>%
drop_na(price) %>%
summarise(price_m = mean(price))
## # A tibble: 1 x 1
## price_m
## <dbl>
## 1 3933.
diamonds %>%
drop_na(price) %>%
summarise(price_md = median(price))
## # A tibble: 1 x 1
## price_md
## <dbl>
## 1 2401
diamonds %>%
drop_na(price) %>%
summarise(price_sd = sd(price),
price_iqr = IQR(price))
## # A tibble: 1 x 2
## price_sd price_iqr
## <dbl> <dbl>
## 1 3989. 4374.
MW - Md ist prop. zur Schiefe (es gibt Extremwerte)
library(skimr)
skim(diamonds)
| Name | diamonds |
| Number of rows | 53940 |
| Number of columns | 10 |
| _______________________ | |
| Column type frequency: | |
| factor | 3 |
| numeric | 7 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| cut | 0 | 1 | TRUE | 5 | Ide: 21551, Pre: 13791, Ver: 12082, Goo: 4906 |
| color | 0 | 1 | TRUE | 7 | G: 11292, E: 9797, F: 9542, H: 8304 |
| clarity | 0 | 1 | TRUE | 8 | SI1: 13065, VS2: 12258, SI2: 9194, VS1: 8171 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| carat | 0 | 1 | 0.80 | 0.47 | 0.2 | 0.40 | 0.70 | 1.04 | 5.01 | ▇▂▁▁▁ |
| depth | 0 | 1 | 61.75 | 1.43 | 43.0 | 61.00 | 61.80 | 62.50 | 79.00 | ▁▁▇▁▁ |
| table | 0 | 1 | 57.46 | 2.23 | 43.0 | 56.00 | 57.00 | 59.00 | 95.00 | ▁▇▁▁▁ |
| price | 0 | 1 | 3932.80 | 3989.44 | 326.0 | 950.00 | 2401.00 | 5324.25 | 18823.00 | ▇▂▁▁▁ |
| x | 0 | 1 | 5.73 | 1.12 | 0.0 | 4.71 | 5.70 | 6.54 | 10.74 | ▁▁▇▃▁ |
| y | 0 | 1 | 5.73 | 1.14 | 0.0 | 4.72 | 5.71 | 6.54 | 58.90 | ▇▁▁▁▁ |
| z | 0 | 1 | 3.54 | 0.71 | 0.0 | 2.91 | 3.53 | 4.04 | 31.80 | ▇▁▁▁▁ |
cut?diamonds %>%
group_by(cut) %>%
summarise(price_avg = mean(price))
## # A tibble: 5 x 2
## cut price_avg
## <ord> <dbl>
## 1 Fair 4359.
## 2 Good 3929.
## 3 Very Good 3982.
## 4 Premium 4584.
## 5 Ideal 3458.
Sortieren Sie den Datensatz nach Preis und zeigen Sie die Top-3-Diamanten (hinsichtlich der max. Höhe des Preises)!
diamonds %>%
arrange(-price) %>% # alternativ: desc(price)
slice(1:3)
## # A tibble: 3 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 2.29 Premium I VS2 60.8 60 18823 8.5 8.47 5.16
## 2 2 Very Good G SI1 63.5 56 18818 7.9 7.97 5.04
## 3 1.51 Ideal G IF 61.7 55 18806 7.37 7.41 4.56
diamonds %>%
slice_max(price, n = 3)
## # A tibble: 3 x 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 2.29 Premium I VS2 60.8 60 18823 8.5 8.47 5.16
## 2 2 Very Good G SI1 63.5 56 18818 7.9 7.97 5.04
## 3 1.51 Ideal G IF 61.7 55 18806 7.37 7.41 4.56
x, y und z multiplizieren.carat).log10(100) == 2
## [1] TRUE
log10(1000) == 3
## [1] TRUE
log10(1e4) == 4 # 10000 = 10^4
## [1] TRUE
:-)
diamonds <-
diamonds %>%
mutate(preis_log10 = log10(price))
In diesem Fall wäre es nicht so gut mit case_when zu arbeiten:
diamonds %>%
mutate(price_oom = case_when(
price > 100 & price < 1000 ~ 2,
price < 10000 ~ 3,
TRUE ~ NA_real_
))
## # A tibble: 53,940 x 12
## carat cut color clarity depth table price x y z preis_log10
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 0.23 Ideal E SI2 61.5 55 326 3.95 3.98 2.43 2.51
## 2 0.21 Premium E SI1 59.8 61 326 3.89 3.84 2.31 2.51
## 3 0.23 Good E VS1 56.9 65 327 4.05 4.07 2.31 2.51
## 4 0.29 Premium I VS2 62.4 58 334 4.2 4.23 2.63 2.52
## 5 0.31 Good J SI2 63.3 58 335 4.34 4.35 2.75 2.53
## 6 0.24 Very Good J VVS2 62.8 57 336 3.94 3.96 2.48 2.53
## 7 0.24 Very Good I VVS1 62.3 57 336 3.95 3.98 2.47 2.53
## 8 0.26 Very Good H SI1 61.9 55 337 4.07 4.11 2.53 2.53
## 9 0.22 Fair E VS2 65.1 61 337 3.87 3.78 2.49 2.53
## 10 0.23 Very Good H VS1 59.4 61 338 4 4.05 2.39 2.53
## # … with 53,930 more rows, and 1 more variable: price_oom <dbl>
diamonds <-
diamonds %>%
mutate(volume = x * y * z)
diamonds <-
diamonds %>%
mutate(price_high = case_when( # ifelse würde auch gehen
price > mean(price) ~ TRUE,
TRUE ~ FALSE
))
diamonds %>%
count(price_high)
## # A tibble: 2 x 2
## price_high n
## <lgl> <int>
## 1 FALSE 34283
## 2 TRUE 19657
diamonds %>%
select(carat, volume) %>%
cor() #Input: Eine Tabelle mit nur numerischen Spalten
## carat volume
## carat 1.0000000 0.9763084
## volume 0.9763084 1.0000000
Welche Hypothese finden Sie am plausibelsten? Begründen Sie!
Betrachten Sie den Zusammenhang von Preis und Gewicht und prüfen Sie, ob Sie den Zusammenhang durch eine Log-Transformation linearisieren können.
Vielleicht hilft auch eine andere Art von Transformation (um den Zusammenhang zu linearisieren)? Probieren Sie es aus!
Hyp.1 : Die Hypothese impliziert, dass der Preiszuwachs von 1 auf 2 Karat zum gleichen Preiszuwachs führt wie die Erhöhung von 2 auf 3 Karat (unter sonst gleichen Umständen).
Die Daten unterstützen das nicht:
diamonds %>%
mutate(carat_rounded = round(carat)) %>%
group_by(carat_rounded) %>%
summarise(mean(price))
## # A tibble: 6 x 2
## carat_rounded `mean(price)`
## <dbl> <dbl>
## 1 0 840.
## 2 1 4163.
## 3 2 12196.
## 4 3 15369.
## 5 4 15715.
## 6 5 18018
Aber bleiben wir für Erste bei einer theoretischen Erörterung.
Hyp 2: “Steigt das Gewicht des Diamanten um 1 Gramm, so steigt der Preis (im Schnitt) um \(b\) Prozent?”
Dieses Wachstumsmuster nennt man auch exponenzielles Wachstum und ist sehr häufig bei allen Wachstumsprozessen, macht aber hier nicht unbedingt viel Sinn (könnte aber trotzdem die Daten passabel beschreiben, sollten wir gleich mal ausprobieren).
Hyp3: “Steigt das Gewicht des Diamanten um 1 Prozent, so steigt der Preis (im Schnitt) um \(b\) Prozent?”
Überlegen wir mal, wie Karat mit dem Preis zusammenhängt. Sachwissen (und eine EDA) zeigt, dass Karat der zentrale Treiber (und Ursache?) des Preises ist. Karat ist ein Form, das Gewicht zu messen: Ein Karat sind 0.2 Gramm. Das Gewicht (Karat; \(c\)) ist eine Funktion des Volumen und Volument ist eine Funktion von Länge, Breite und Höhe (x,y,z): \(c =f(x,y,z\)). Einige Momente ruhiges Nachdenken zeigen, dass solche Zusammenhänge eine Potenzfunktion darstellen. Potenzfunktionien haben stets das Wachstumsmuster wie in Hypothese 3 aufgeführt. Diese “Theorie” spricht sich also für die Stichhaltigkeit von Hypothese 3 aus. Das sollten wir gleich mal an den Daten überprüfen!
Ohne Transformation:
diamonds %>%
filter(carat < 2.5) %>% # bleiben >50000 übrig
ggplot() +
aes(x = carat, y = price) +
geom_hex() +
geom_smooth() +
geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'
Mit Log-Transformation:
diamonds %>%
filter(carat < 2.5) %>%
ggplot() +
aes(x = carat, y = log(price)) +
geom_hex() +
geom_smooth() +
geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'
diamonds %>%
filter(carat < 2.5) %>%
ggplot() +
aes(x = log(carat), y = log(price)) +
geom_hex() +
geom_smooth() +
geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'
diamonds %>%
filter(carat < 2.5) %>%
ggplot() +
aes(x = carat, y = sqrt(price)) +
geom_hex() +
geom_smooth() +
geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'
diamonds %>%
filter(carat < 2.5) %>%
ggplot() +
aes(x = log(carat), y = price^(1/3)) +
geom_hex() +
geom_smooth() +
geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'
diamonds %>%
filter(carat < 2.5) %>%
ggplot() +
aes(x = carat, y = price^(1/3)) +
geom_hex() +
geom_smooth() +
geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'
Vergleichen Sie die Vorhersagegüte von Modellen, die den Preis anhand des Gewichts vorhersagen.
lm1 <- lm(price ~ carat, data = diamonds %>% filter(carat < 2.5))
plot(lm1)
summary(lm1)$r.squared
## [1] 0.8520234
lm2 <- lm(log(price) ~ carat, data = diamonds %>% filter(carat != 0))
plot(lm2)
summary(lm2)$r.squared
## [1] 0.8467802
lm3 <- lm(log(price) ~ log(carat), data = diamonds)
plot(lm3)
summary(lm3)$r.squared
## [1] 0.9329893
price?